home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtstream.i < prev    next >
Text File  |  1997-10-26  |  7KB  |  196 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtStreams;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  45.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  46.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  47.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  48.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  49.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  50.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  51.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  61.  
  62.  
  63.  
  64.  
  65. FROM SYSTEM       IMPORT  ADDRESS, BYTE, WORD, ADR, TSIZE;
  66. FROM MagicStrings IMPORT  Assign, Equal, CAPS;
  67. FROM MagicDOS     IMPORT  ReadOnly, Hidden, System, Volume, Folder, Archive,
  68.                           Fcreate, NamePRN, NameAUX, NameCON, Read, Write, 
  69.                           ReadWrite, StdIn, StdOut, Serial, Printer, Fopen, 
  70.                           Fclose, Fread, Fwrite, Fdelete, SeekStart, SeekPos,
  71.                           SeekEnd, Fseek;
  72.  
  73. TYPE    STREAM =        POINTER TO Stream;
  74.         Stream =        RECORD
  75.                          out:       sINTEGER;
  76.                          endpos:    lINTEGER;
  77.                          fname:     ARRAY [0..255] OF CHAR;
  78.                         END;
  79.  
  80.  
  81. PROCEDURE OpenStream (VAR s: STREAM; name: ARRAY OF CHAR;
  82.                       kind: StreamMode): INTEGER;
  83. VAR lc: lINTEGER;
  84. BEGIN
  85.  ALLOCATE (s,  TSIZE (Stream));    IF s = NIL THEN  RETURN -1;  END;
  86.  WITH s^ DO
  87.   Assign (name, fname);  CAPS (name);
  88.   IF Equal (name, NameCON) THEN     out:= StdOut;  endpos:= 0;
  89.   ELSIF Equal (name, NamePRN) THEN  out:= Printer;  endpos:= 0;
  90.   ELSIF Equal (name, NameAUX) THEN  out:= Serial;  endpos:= 0;
  91.   ELSE
  92.    out:= -1;  endpos:= 0;
  93.    IF kind = READ THEN
  94.     out:= Fopen (name, Read);
  95.     IF out < 0 THEN  RETURN -1;  END;
  96.     endpos:= Fseek (0, out, SeekEnd);
  97.     lc:= Fseek (0, out, SeekStart);
  98.    ELSE
  99.     out:= Fopen (name, {ReadWrite});
  100.     IF out < 0 THEN  out:= Fcreate (name, {});  END;
  101.     IF out < 0 THEN  RETURN -1;  END;
  102.     endpos:= Fseek (0, out, SeekEnd);
  103.    END;
  104.   END;
  105.  END;
  106.  RETURN 0;
  107. END OpenStream;
  108.  
  109. PROCEDURE CloseStream (VAR s: STREAM): sINTEGER;
  110. VAR i: sINTEGER;
  111. BEGIN
  112.  IF s # NIL THEN
  113.   IF s^.out > Printer THEN
  114.    i:= Fclose (s^.out);
  115.    IF i < 0 THEN  RETURN i;  END;
  116.   END;
  117.   DEALLOCATE (s, 0);  
  118.   RETURN 0;
  119.  END;
  120. END CloseStream;
  121.  
  122. PROCEDURE WriteStream (s: STREAM; VAR a: ARRAY OF LOC);
  123. VAR no: lCARDINAL;
  124. BEGIN
  125.  IF s # NIL THEN
  126.   WITH s^ DO
  127.    no:= LONG (HIGH (a) + 1);  Fwrite (out, no, ADR(a));
  128.   END;
  129.  END;
  130. END WriteStream;
  131.  
  132. PROCEDURE ReadStream (s: STREAM; VAR a: ARRAY OF LOC);
  133. VAR no: lCARDINAL;
  134.     h:  sINTEGER;
  135. BEGIN
  136.  IF s # NIL THEN
  137.   WITH s^ DO
  138.    IF  out = StdOut  THEN  h:= StdIn;  ELSE  h:= out;  END;
  139.    IF  h = Printer  THEN  RETURN;  END;
  140.    no:= LONG (HIGH (a) + 1);  Fread (h, no, ADR(a));
  141.   END;
  142.  END;
  143. END ReadStream;
  144.  
  145. PROCEDURE Streampos (s: STREAM): lINTEGER;
  146. BEGIN
  147.  IF s # NIL THEN
  148.   IF s^.out > Printer THEN  RETURN Fseek (0, s^.out, SeekPos);
  149.                       ELSE  RETURN 0;
  150.   END;
  151.  END;
  152. END Streampos;
  153.  
  154. PROCEDURE StreamEnd (s: STREAM); 
  155. VAR p: lINTEGER;
  156. BEGIN
  157.  IF s # NIL THEN
  158.   IF s^.out > Printer THEN  p:= Fseek (0, s^.out, SeekEnd);  END;
  159.  END;
  160. END StreamEnd;
  161.  
  162. PROCEDURE SetStreampos (s: STREAM; mode: Posmode; pos: lINTEGER);
  163. VAR p: lINTEGER;
  164. BEGIN
  165.  IF s # NIL THEN
  166.   IF s^.out > Printer THEN  p:= Fseek (pos, s^.out, ORD(mode));  END;
  167.  END;
  168. END SetStreampos;
  169.  
  170. PROCEDURE EndofStream (s: STREAM): BOOLEAN;
  171. VAR p: lINTEGER;
  172. BEGIN
  173.  IF s # NIL THEN
  174.   IF s^.out > Printer THEN  p:= Fseek (0, s^.out, SeekPos);  RETURN p >= s^.endpos;
  175.                       ELSE  RETURN FALSE;
  176.   END;
  177.  END;
  178. END EndofStream;
  179.  
  180. PROCEDURE StreamName (s: STREAM; VAR name: ARRAY OF CHAR);
  181. BEGIN
  182.  IF s # NIL THEN  Assign (s^.fname, name);
  183.             ELSE  name[0]:= 0C;
  184.  END;
  185. END StreamName;
  186.  
  187. PROCEDURE StreamHandle (s: STREAM; VAR handle: sINTEGER);
  188. BEGIN
  189.  IF s # NIL THEN handle:= s^.out;
  190.             ELSE handle:= -1;
  191.  END;
  192. END StreamHandle;
  193.  
  194. END mtStreams.
  195.  
  196.